home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / tests / tcllib.test < prev    next >
Encoding:
Text File  |  1992-11-07  |  7.2 KB  |  259 lines
  1. #
  2. # tcllib.test
  3. #
  4. # Tests for commands and functionallity involved in demand loadable Tcl
  5. # libraries.
  6. #---------------------------------------------------------------------------
  7. # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # $Id: tcllib.test,v 2.0 1992/10/16 04:50:17 markd Rel $
  17. #------------------------------------------------------------------------------
  18. #
  19.  
  20. if {[info procs test] == ""} then {source testlib.tcl}
  21.  
  22. rename SAVED_UNKNOWN unknown
  23. set SAVE_TCLPATH $TCLPATH
  24. set TCLPATH {}
  25. global TCLENV
  26. catch {unset auto_path}
  27.  
  28. if {[id user] == "root"} {
  29.     puts stderr "*************************************************************"
  30.     puts stderr "You are running as `root', certain tcllib tests will be"
  31.     puts stderr "skipped"
  32.     puts stderr "*************************************************************"
  33. }
  34.  
  35. #
  36. # Since we have libraries coming and going in this test, we need to
  37. # reset the environment.  The file id that is used by the tcllib code
  38. # is based on inode, so if a library is purged, it might be recycled.
  39. #
  40. proc TclLibReset {} {
  41.     global TCLENV
  42.     foreach idx [array names TCLENV] {
  43.         case $idx {
  44.             {PROC:*} {unset TCLENV($idx)}
  45.             {PKG:*}  {unset TCLENV($idx)}
  46.             {@*}     {unset TCLENV($idx)}
  47.         }
  48.     }
  49.     autoload buildidx.tcl buildpackageindex
  50. }
  51.  
  52. proc TclLibCleanUp {} {
  53.     catch {chmod +rwx tcllib1.dir}
  54.     catch {chmod +rwx tcllib2.dir}
  55.     unlink -nocomplain [glob -nocomplain tcllib1.dir/* tcllib1.dir/.*]
  56.     unlink -nocomplain [glob -nocomplain tcllib2.dir/* tcllib2.dir/.*]
  57.     catch {rmdir tcllib1.dir}
  58.     catch {rmdir tcllib2.dir}
  59.     TclLibReset
  60. }
  61.  
  62. TclLibCleanUp
  63.  
  64. proc PutFile {fileName args} {
  65.     set fp [open $fileName w]
  66.     foreach line $args {
  67.         puts $fp $line
  68.     }
  69.     close $fp
  70. }
  71.  
  72. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  73.  
  74. #
  75. # Test parameter checking for the basic commands that are implemented
  76. # in C.
  77. #
  78.  
  79. Test tcllib-1.1 {command parameter checking} {
  80.     demand_load
  81. } 1 {wrong # args: demand_load procedure}
  82.  
  83. Test tcllib-1.2 {command parameter checking} {
  84.     demand_load a b c d
  85. } 1 {wrong # args: demand_load procedure}
  86.  
  87. Test tcllib-1.3 {command parameter checking} {
  88.     loadlibindex
  89. } 1 {wrong # args: loadlibindex libFile}
  90.  
  91. Test tcllib-1.4 {command parameter checking} {
  92.     loadlibindex a b c d
  93. } 1 {wrong # args: loadlibindex libFile}
  94.  
  95. #
  96. # Test error recovery from bogus paths (should ignore path and not find proc)
  97. #
  98.  
  99. Test tcllib-2.1 {bogus path test} {
  100.     set TCLPATH [list /bogus/dir/path/no/work [pwd]/../tcllib]
  101.     TclLibAAA
  102. } 1 {invalid command name: "TclLibAAA"}
  103.  
  104. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  105.  
  106. Test tcllib-2.2 {bogus path test} {
  107.     set TCLPATH [list ~bogususerman/tcllib [pwd]/../tcllib]
  108.     TclLibAAA
  109. } 1 {invalid command name: "TclLibAAA"}
  110.  
  111. Test tcllib-2.3 {bogus path test} {
  112.     set TCLPATH [pwd]/../tcllib
  113.     set auto_path [list /bogus/dir/path/no/work]
  114.     TclLibAAA
  115. } 1 {invalid command name: "TclLibAAA"}
  116.  
  117.  
  118. #
  119. # Test error recovery from bogus package library indices.
  120. #
  121.  
  122. proc BuildTestLib {name {pbase TclLibAA}} {
  123.    PutFile $name \
  124.         "#@package: $name-package ${pbase}B ${pbase}C ${pbase}D" \
  125.         "proc ${pbase}B {} {return \"***${pbase}B***\"}" \
  126.         "proc ${pbase}C {} {return \"***${pbase}C***\"}" \
  127.         "proc ${pbase}D {} {return \"***${pbase}D***\"}"
  128. }
  129.  
  130. mkdir tcllib1.dir
  131. BuildTestLib tcllib1.dir/test1.tlib
  132. PutFile tcllib1.dir/test1.tndx {bogus
  133. data}
  134.  
  135. set TCLPATH [list [pwd]/tcllib1.dir [pwd]/../tcllib]
  136.  
  137. TestReg tcllib-3.1 {bogus package library index} {
  138.     TclLibAAB
  139. } 1 {^format error in library index "/.*test1.tndx" \(bogus\)$}
  140.  
  141. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  142.  
  143. PutFile tcllib1.dir/test1.tndx \
  144.     {test1-package 56 240 TclLibAAB TclLibAAC TclLibAAD}
  145.  
  146. TestReg tcllib-3.2 {bogus package library index} {
  147.     TclLibAAB
  148. } 1 {^range to eval outside of file bounds "/.*test1.tlib"$}
  149.  
  150. PutFile tcllib1.dir/test1.tndx \
  151.     {test1-package -1 140 TclLibAAB TclLibAAC TclLibAAD}
  152.  
  153. TestReg tcllib-3.3 {bogus package library index} {
  154.     TclLibAAB
  155. } 1 {^range to eval outside of file bounds "/.*test1.tlib"$}
  156.  
  157. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  158.  
  159. PutFile tcllib1.dir/test1.tndx \
  160.     {test1-package 156 40 TclLibAAB TclLibAAC TclLibAAD}
  161.  
  162. TestReg tcllib-3.4 {bogus package library index} {
  163.     TclLibAAB
  164. } 1 {^range to eval outside of file bounds "/}
  165.  
  166. set TCLPATH [list [pwd]/tcllib2.dir [pwd]/../tcllib]
  167.  
  168. if {[id user] != "root"} {
  169.     Test tcllib-4.1 {bad rebuild package library index} {
  170.         global errorCode errorInfo
  171.         mkdir tcllib2.dir
  172.         BuildTestLib tcllib2.dir/test1.tlib TclLibAB
  173.         chmod -w tcllib2.dir
  174.         list [catch {TclLibABB} msg] [crange $msg 0 25] $TCLENV(inUnknown) \
  175.              [lrange $errorCode 0 1] \
  176.              [string match "*while loading Tcl package library*" $errorInfo] \
  177.              [string match "*while demand loading \"TclLibABB\"*" $errorInfo]
  178.     } 0 {1 {building package index for} 0 {UNIX EACCES} 1 1}
  179. }
  180.  
  181. TclLibCleanUp
  182. mkdir tcllib1.dir
  183.  
  184. set TCLPATH [list [pwd]/tcllib1.dir [pwd]/../tcllib]
  185.  
  186. PutFile tcllib1.dir/tclIndex "#" "badline" "nukearray nukearray.tmp" \
  187.     "baz baz.tmp"
  188.  
  189. TestReg tcllib-5.1 {bogus Ousterhout library index} {
  190.     nukearray
  191. } 1 {^format error in library index "/.*$}
  192.  
  193. PutFile tcllib1.dir/tclIndex "#" "nukearray nukearray.tmp" "baz baz.tmp"
  194.  
  195. TestReg tcllib-5.2 {missing file found with Ousterhout library index} {
  196.     nukearray
  197. } 1 {couldn't read file}
  198.  
  199. PutFile tcllib1.dir/nukearray.tmp {proc nukearray {} {}}
  200. chmod 000 tcllib1.dir/nukearray.tmp
  201.  
  202. if {[id user] != "root"} {
  203.     TestReg tcllib-5.3 {missing file found with Ousterhout library index} {
  204.         nukearray
  205.     } 1 {couldn't read file}
  206. }
  207.  
  208. TclLibCleanUp
  209. mkdir tcllib1.dir
  210.  
  211. BuildTestLib  tcllib1.dir/test2.tlib TclLibAC
  212.  
  213. PutFile tcllib1.dir/tclIndex "#" "nukearray nukearray.tmp" "baz baz.tmp"
  214. PutFile tcllib1.dir/nukearray.tmp {proc nukearray {} {return "@nukearray@"}}
  215.  
  216. Test tcllib-6.1 {successful library access} {
  217.     TclLibACB
  218. } 0 {***TclLibACB***}
  219.  
  220. Test tcllib-6.2 {successful library access} {
  221.     TclLibACB
  222. } 0 {***TclLibACB***}
  223.  
  224. Test tcllib-6.3 {successful library access} {
  225.     nukearray
  226. } 0 {@nukearray@}
  227.  
  228. #
  229. # Test skipping of duplicate packages.
  230. #
  231. TclLibCleanUp
  232. mkdir {tcllib1.dir tcllib2.dir}
  233. set TCLPATH [list [pwd]/tcllib1.dir [pwd]/tcllib2.dir [pwd]/../tcllib]
  234.  
  235. PutFile tcllib1.dir/test1.tlib \
  236.     {#@package: test-pkg DupPkgTest} \
  237.     {proc DupPkgTest {} {return {Version-1}}
  238. }
  239. PutFile tcllib2.dir/test2.tlib \
  240.     {#@package: test-pkg DupPkgTest} \
  241.     {proc DupPkgTest {} {return {Version-2}}
  242. }
  243.  
  244. Test tcllib-7.1 {Duplicate package handling} {
  245.     DupPkgTest
  246. } 0 {Version-1}
  247.  
  248.  
  249. TclLibCleanUp
  250.  
  251. rename TclLibCleanUp {}
  252. rename PutFile {}
  253. rename TclLibReset {}
  254.  
  255. set TCLPATH $SAVE_TCLPATH
  256. rename unknown SAVED_UNKNOWN
  257.  
  258.  
  259.